home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / ctlib100.zip / INSTALL.LZH / TABLE1.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-12  |  5KB  |  163 lines
  1. {**************************************************************************}
  2. {*  BitSoft Development, L.L.C.                                           *}
  3. {*  Copyright (C) 1995, 1996 BitSoft Development, L.L.C.                  *}
  4. {*  All rights reserved.                                                  *}
  5. {*  Containers Library demo                                               *}
  6. {**************************************************************************}
  7.  
  8. program Table1;
  9.  
  10. {$X+}
  11.  
  12. { This program demonstrates how to create a field structure, use it to
  13. initialize a table, insert a data item, and return results.  It contains all
  14. examples described in the documentation chapter on tables. }
  15.  
  16. uses
  17.   Objects, Crt, BsdTest, ctTypes, ctFields, ctTables;
  18.  
  19. const
  20.   TempFile = 'test.dat';
  21.   BufferSize = 2048;
  22.   OpenedFromDisk: Boolean = False;
  23.  
  24. var
  25.   FieldStructure: PFieldStructure;
  26.   Table: PTable;
  27.  
  28. type
  29.   PAddressRec = ^TAddressRec;
  30.   TAddressRec = record
  31.     Line1: string[50];
  32.     Line2: string[50];
  33.     City: string[50];
  34.     State: string[50];
  35.   end;  { of TAddressRec }
  36.  
  37.  
  38. function AddressFieldStructure: PFieldStructure;
  39. var
  40.   FieldStructure: PFieldStructure;
  41.   Field: PField;
  42.   Name: TFieldName;
  43.   i: Integer;
  44. begin
  45.   FieldStructure := New(PFieldStructure,Init(4,1));
  46.   if (FieldStructure <> nil) then
  47.     for i := 1 to 4 do
  48.     begin
  49.       case i of
  50.         1: Name := 'Line1';
  51.         2: Name := 'Line2';
  52.         3: Name := 'City';
  53.         4: Name := 'State';
  54.       end;
  55.       Field := New(PField,Init(Name,ftString,50,0));
  56.       if (Field <> nil) then
  57.         FieldStructure^.Insert(Field)
  58.       else Error('Out of memory.  Could not create field ' + Name + '.');
  59.     end;
  60.   AddressFieldStructure := FieldStructure;
  61. end;
  62.  
  63.  
  64. procedure InsertAddresses;
  65. var
  66.   Address: PAddressRec;
  67. begin
  68.   GetMem(Address,SizeOf(TAddressRec));
  69.   if Address = nil then
  70.     Error('Out of memory.  Could not create address record.');
  71.   Address^.Line1 := 'Mickey Mouse';
  72.   Address^.Line2 := 'Disney World';
  73.   Address^.City  := 'Orlando';
  74.   Address^.State := 'Florida';
  75.   Table^.Insert(Address);
  76. end;
  77.  
  78. procedure ShowAddresses;
  79. var
  80.   RecNo: LongInt;
  81.   procedure ShowAddress (Address: PAddressRec); far;
  82.   begin
  83.     WriteLn('Record Number = ',RecNo);
  84.     with Address^ do
  85.     begin
  86.       WriteLn('   ',Line1);
  87.       WriteLn('   ',Line2);
  88.       WriteLn('   ',City,', ',State);
  89.     end;
  90.     WriteLn;
  91.     Inc(RecNo);
  92.   end;
  93. begin
  94.   with Table^ do
  95.   begin
  96.     if not OpenedFromDisk then
  97.     begin
  98.       WriteLn('Table''s Field Structure');
  99.       Structure^.ShowInfo(OutPut);
  100.       WriteLn;
  101.     end;
  102.     RecNo := 0;
  103.     ForEach(@ShowAddress);
  104.   end;
  105. end;
  106.  
  107. var
  108.   F: File;  { just used to delete table so we don't litter your disk }
  109.   Size: LongInt;
  110.   Stream: PStream;
  111. begin
  112.   ClrScr;
  113.   RegisterType(RField);
  114.   RegisterType(RFieldStructure);
  115.   Size := MemAvail;
  116.   FieldStructure := AddressFieldStructure;
  117.   if (FieldStructure = nil) then
  118.     Error('Error creating field structure.');
  119.   Stream := New(PBufStream,Init(TempFile, stCreate, 2048));
  120.   Table := New(PTable, Init(FieldStructure, Stream));
  121.   if (Table = nil) then
  122.   begin
  123.       { Caution!!!! Don't dispose of the table structure if table
  124.         initialization was successful.  It is used and will be disposed of by
  125.         the table. }
  126.     Dispose(FieldStructure, Done);
  127.     Error('Error constructing table.');
  128.   end;
  129.   WriteLn('Table created successfully.');
  130.   InsertAddresses;
  131.   WriteLn('Addresses inserted successfully.');
  132.   WriteLn;
  133.   ShowAddresses;
  134.   WriteLn('Closing table.');
  135.   Dispose(Table, Done);
  136.     { Tables don't dispose of the stream on which they are stored so that the
  137.       stream can be used for other purposes within the application.  You must
  138.       explicitly dispose of the table's stream when you are finished using it
  139.       to prevent a memory leak and ensure all data is flushed from the
  140.       stream's buffers. }
  141.   Dispose(Stream,Done);
  142.   WriteLn('Reopening table.');
  143.   Stream := New(PBufStream, Init(TempFile, stOpen, BufferSize));
  144.   Table := New(PTable, Open(Stream));
  145.   if (Table = nil) then
  146.     Error('Error opening table.')
  147.   else begin
  148.     WriteLn('Opened table successfully.');
  149.     OpenedFromDisk := True;
  150.   end;
  151.   WriteLn;
  152.   ShowAddresses;
  153.   Dispose(Table,Done);
  154.   Dispose(Stream,Done);
  155.     { remove the table }
  156.   Assign(F,TempFile);
  157.   {$I-}
  158.   Erase(F);
  159.   {$I+}
  160.   if (Size <> MemAvail) then
  161.     WriteLn('Memory leak.');
  162.   ReadLn;
  163. end.